home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir42 / fpw2xl.zip / PPGRP.PRG < prev   
Text File  |  1993-06-25  |  9KB  |  312 lines
  1. CLEAR
  2. @ 10,10 SAY "PP Graph"
  3. *
  4. SET MESSAGE TO ""
  5. *
  6. CLOSE DATA
  7. SELE 1
  8. USE visit INDEX vid
  9. *
  10. SELE 2
  11. USE C:\foxprow\apps\appt\graphs\lgtemp INDEX C:\foxprow\apps\appt\graphs\lgtemp EXCLUSIVE
  12. SET SAFETY OFF
  13. ZAP
  14. SET SAFETY ON
  15. SCATTER TO mtotal BLANK
  16. mtotal(1)="TOTAL CASES"
  17. SCATTER TO mpp BLANK
  18. mpp(1)="Total Private Patients"
  19. SCATTER TO mnhs BLANK
  20. mnhs(1)="Total NHS Patients"
  21. *
  22. USE C:\foxprow\apps\appt\graphs\lgtemp INDEX C:\foxprow\apps\appt\graphs\lgtemp
  23. SELE 3
  24. USE providor INDEX iid
  25. SELE 1
  26. SET RELATION TO iid INTO providor
  27. mrecs=RECCOUNT()
  28. *
  29. SCAN
  30.     IF MOD(RECNO(),10)=0
  31.         DO percent WITH mrecs,RECNO()
  32.     ENDIF
  33.     yi=YEAR(visit->appt_date)-1990
  34.     mi=MONTH(visit->appt_date)
  35.     ptr=yi*12 +mi +1
  36.     *
  37.     * ptr is used to update mtotal, mpp, mnhs as appropriate
  38.     *
  39.     mtotal(ptr) = mtotal(ptr) +1
  40.  
  41.     DO CASE
  42.         CASE EMPTY(visit.ref_type)
  43.             IF  (providor.name="unknown") .OR. ;
  44.                     (providor.name="Mental Health") .OR. ;
  45.                     ("NHS" $ providor.name) .OR. ;
  46.                     (providor.name="Northern Health and Soc") .OR. ;
  47.                     (providor.name="Horton General Hospital") .OR. ;
  48.                     (providor.name="Nuffield Orthopaedic Centre") .OR. ;
  49.                     (providor.name="Salisbury Health Authority") .OR. ;
  50.                     (providor.name="Eastern Health & Social Serv") .OR. ;
  51.                     (providor.name="Western Health & Social Serv") .OR. ;
  52.                     (providor.name="Western H & SS") .OR. ;
  53.                     (providor.name="Southern H & SS") .OR. ;
  54.                     (providor.name="SWINDON Health") .OR. ;
  55.                     (providor.name="Wycombe Health") .OR. ;
  56.                     (providor.name="Kettering General") .OR. ;
  57.                     (providor.name="Worcester Royal Infirmary") .OR. ;
  58.                     (providor.name="Northampton General") .OR. ;
  59.                     (providor.name="Milton Keynes General") .OR. ;
  60.                     (providor.name="Stantonbury Health Centre") .OR. ;
  61.                     (providor.name="Gloucester Health") .OR. ;
  62.                     (providor.name="Princess Alexandra Hosp") .OR. ;
  63.                     (providor.name="South Warwickshire HA") .OR. ;
  64.                     (providor.name="Basingstoke District Hospital") .OR. ;
  65.                     (providor.name="Cambridge Military") .OR. ;
  66.                     (providor.name="Bedford Hospital") .OR. ;
  67.                     (providor.name="West Surrey & North East Hants") .OR. ;
  68.                     (providor.name="Redbridge & Waltham Forest") .OR. ;
  69.                     (providor.name="GP (Oxfordshire)") .OR. ;
  70.                     (providor.name="RAF HALTON") .OR. ;
  71.                     (providor.name="North West Anglia Health")
  72.                 *
  73.                 mnhs(ptr)=mnhs(ptr) +1
  74.  
  75.             ELSE
  76.                 mpp(ptr)=mpp(ptr) +1
  77.             ENDIF
  78.  
  79.         CASE ref_type ="NHS"
  80.             mnhs(ptr)=mnhs(ptr) +1
  81.  
  82.         CASE ref_type ="ECR"
  83.             mnhs(ptr)=mnhs(ptr) +1
  84.  
  85.         CASE ref_type ="GPFH"
  86.             mnhs(ptr)=mnhs(ptr) +1
  87.  
  88.         CASE ref_type ="PP"
  89.             mpp(ptr)=mpp(ptr) +1
  90.  
  91.     ENDCASE
  92. ENDSCAN
  93. DO percent WITH 0
  94. *
  95. USE IN visit
  96. USE IN providor
  97. *
  98. * Now fiddle with the results !
  99. *
  100. SELE lgtemp
  101. APPE BLANK
  102. GATHER FROM mtotal
  103. APPE BLANK
  104. GATHER FROM mpp
  105. APPE BLANK
  106. GATHER FROM mnhs
  107. *
  108. DELETE FILE s:\win\pp.csv
  109. COPY TO s:\win\pp.csv DELIMITED
  110. *
  111. *  Now the really fancy stuff...
  112. *
  113. xlsystem = -1
  114. xlsheet1 = -1
  115. *
  116. =ddesetoption('SAFETY',.F.)
  117. =ddesetoption('TIMEOUT',2000)
  118. *
  119. xlsystem = DDEINITIATE('Excel','System')
  120. IF xlsystem <0
  121.     ! /n2 C:\excel\excel
  122.     tries = 10
  123.     DO WHILE (tries >0) AND (xlsystem <0)
  124.         WAIT WINDOW "Waiting for"+CHR(13)+"EXCEL to initialise" TIMEOUT 2
  125.         tries = tries-1
  126.         xlsystem = DDEINITIATE('Excel','System')
  127.     ENDDO
  128.     IF tries =0
  129.         DO abend WITH "Excel not responding"
  130.     ENDIF
  131. ENDIF
  132. xlsheet1 = DDEINITIATE('Excel','Sheet1')
  133. tries = 10
  134. DO WHILE (tries >0) AND (xlsheet1 <0)
  135.     WAIT WINDOW "Waiting for"+CHR(13)+"EXCEL - Sheet1" TIMEOUT 2
  136.     tries = tries-1
  137.     xlsheet1 = DDEINITIATE('Excel','Sheet1')
  138. ENDDO
  139. IF tries =0
  140.     DO abend WITH "Sheet1 not responding"
  141. ENDIF
  142. *
  143. *  Now we have the DDE channels open
  144. *
  145. xlrow=1
  146. FOR xlcol=2 TO 49
  147.     thedate=mmmyy(xlcol-1)
  148.     =rcpoke(thedate)
  149. ENDFOR
  150. *
  151. xlrow=2
  152. xlcol=1
  153. =rcpoke('NHS')
  154. FOR xlcol=2 TO 49
  155.     =rcpoke(ALLTRIM(STR(mnhs(xlcol))))
  156. ENDFOR
  157. *
  158. xlrow=3
  159. xlcol=1
  160. =rcpoke('PP')
  161. FOR xlcol=2 TO 49
  162.     =rcpoke(ALLTRIM(STR(mpp(xlcol))))
  163. ENDFOR
  164. *
  165. * data complete, now graph it!
  166. *
  167. if not ddeexecute(xlsystem,'[select("R1:R3")]')
  168.     do abend with '[select(!R1:R3)]'
  169. endif
  170. if not ddeexecute(xlsystem,'[new(2)]')
  171.     do abend with "new(2)"
  172. endif
  173. if not ddeexecute(xlsystem,'[page.setup("","",1,1,1,1,3,TRUE,TRUE,2,9,200)]')
  174.     do abend with '[page.setup("","",1,1,1,1,3,TRUE,TRUE,2,9,200)]'
  175. endif
  176. *
  177. if not ddeexecute(xlsystem,'[legend(TRUE)]')
  178.     do abend with '[legend(TRUE)]'
  179. endif
  180. if not ddeexecute(xlsystem,'[select("Legend")]')
  181.     do abend with '[select("Legend")]'
  182. endif
  183. if not ddeexecute(xlsystem,'[patterns(1,,,,FALSE,1,,,,FALSE)]')
  184.     do abend with '[patterns(1,,,,FALSE,1,,,,FALSE)]'
  185. endif
  186. if not ddeexecute(xlsystem,'[format.legend(3)]')
  187.     do abend with '[format.legend(3)]'
  188. endif
  189. *
  190. if not ddeexecute(xlsystem,'[attach.text(1)]')
  191.     do abend with '[attach.text(1)]'
  192. endif
  193. if not ddeexecute(xlsystem,'[formula("=""Patient Referrals""")]')
  194.     do abend with '[formula("=""Patient Referrals""")]'
  195. endif
  196. if not ddeexecute(xlsystem,'[format.font(0,1,FALSE,"Arial",14,FALSE,FALSE,FALSE,FALSE)]')
  197.     do abend with '[format.font(0,1,FALSE,"Arial",14,FALSE,FALSE,FALSE,FALSE)]'
  198. endif
  199. *
  200. if not ddeexecute(xlsystem,'[gallery.column(3,TRUE)]')
  201.     do abend with '[gallery.column(3,TRUE)]'
  202. endif
  203. if not ddeexecute(xlsystem,'[gridlines(FALSE,FALSE,TRUE,FALSE)]')
  204.     do abend with '[gridlines(FALSE,FALSE,TRUE,FALSE)]'
  205. endif
  206. *
  207. if not ddeexecute(xlsystem,'[select("Axis 2")]')
  208.     do abend with '[select("Axis 2")]'
  209. endif
  210. if not ddeexecute(xlsystem,'[patterns(1,,,,4,1,4)]')
  211.     do abend with '[patterns(1,,,,4,1,4)]'
  212. endif
  213. if not ddeexecute(xlsystem,'[format.font(0,1,FALSE,"Arial",6,FALSE,FALSE,FALSE,FALSE)]')
  214.     do abend with '[format.font(0,1,FALSE,"Arial",6,FALSE,FALSE,FALSE,FALSE)]'
  215. endif
  216. *
  217. * printing can take a while - allow 30 seconds!
  218. *
  219. =ddesetoption('TIMEOUT',30000)
  220. if not ddeexecute(xlsystem,'[print(1,,,1,FALSE,FALSE,1)]')
  221.     do abend with '[print(1,,,1,FALSE,FALSE,1)]'
  222. endif
  223. *
  224. * reset to 2 seconds
  225. *
  226. =ddesetoption('TIMEOUT',2000)
  227. if not ddeexecute(xlsystem,'[gallery.column(5,TRUE)]')
  228.     do abend with '[gallery.column(5,TRUE)]'
  229. endif
  230. if not ddeexecute(xlsystem,'[gridlines(FALSE,FALSE,TRUE,FALSE)]')
  231.     do abend with '[gridlines(FALSE,FALSE,TRUE,FALSE)]'
  232. endif
  233. =ddesetoption('TIMEOUT',30000)
  234. if not ddeexecute(xlsystem,'[print(1,,,1,FALSE,FALSE,1)]')
  235.     do abend with '[print(1,,,1,FALSE,FALSE,1)]'
  236. endif
  237. *
  238. * reset to 2 seconds
  239. *
  240. =ddesetoption('TIMEOUT',2000)
  241. if not ddeexecute(xlsystem,'[close(FALSE)]')
  242.     do abend with '[close(FALSE)] - Graph'
  243. endif
  244. *
  245. * Close DDE conversation
  246. *
  247. IF NOT DDETERMINATE(xlsheet1)
  248.     DO abend WITH "Could not Terminate Sheet1"
  249. ENDIF
  250. xlsheet1 = -1
  251. *
  252. *
  253. if not ddeexecute(xlsystem,'[close(FALSE)]')
  254.     do abend with '[close(FALSE)] - Sheet'
  255. endif
  256. *
  257. * Close Excel
  258. *
  259. =ddeexecute(xlsystem,'[Quit]')
  260. *
  261. * We can ignore the error from this, because we shut down Excel with the
  262. *  previous command...
  263. *
  264. =DDETERMINATE(xlsystem)
  265. xlsystem = -1
  266. *
  267. *
  268. *
  269. DO abend
  270. RETURN
  271.  
  272. FUNCTION rc
  273.     PARAMETERS arow,acol
  274.     RETURN 'R'+ALLTRIM(STR(arow))+'C'+ALLTRIM(STR(acol))
  275.  
  276. FUNCTION mmmyy
  277.     PARAMETER monthindex
  278.     yi=0
  279.     mi=monthindex%12
  280.     yi=INT(monthindex/12)
  281.     yi=IIF(mi=0,yi-1,yi)
  282.     mi=IIF(mi=0,12,mi)
  283.     RETURN LEFT(CMONTH(CTOD('1/'+STR(mi)+'/90')),3)+'-'+ALLTRIM(STR(yi+90))
  284.  
  285. PROCEDURE rcpoke
  286.     PARAMETERS astring
  287.     IF NOT DDEPOKE(xlsheet1,rc(xlrow,xlcol),astring)
  288.         DO abend WITH "Poke @"+rc(xlrow,xlcol)+" "+astring
  289.     ENDIF
  290.     RETURN
  291.  
  292. PROCEDURE abend
  293.     PARAMETERS amessage
  294.     IF TYPE('amessage') = 'C'
  295.         WAIT WINDOW "DDE Error"+CHR(13)+amessage
  296.     ENDIF
  297.     CLOSE DATA
  298.     CLEAR
  299.     RELEASE mtotal
  300.     RELEASE mpp
  301.     RELEASE mnhs
  302.     IF TYPE('amessage') = 'C'
  303.         if xlsheet1 # -1
  304.             =DDETERMINATE(xlsheet1)
  305.         endif
  306.         if xlsystem # -1
  307.             =DDETERMINATE(xlsystem)
  308.         endif
  309.         CANCEL
  310.     ENDIF
  311.     RETURN
  312.